home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Info / For Developers / GhostScript 5.10 / MacGS-510 / files / gs_lev2.ps < prev    next >
Encoding:
Text File  |  1997-07-23  |  14.2 KB  |  460 lines  |  [TEXT/gsVR]
  1. %    Copyright (C) 1990, 1996, 1997 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This file is part of Aladdin Ghostscript.
  4. % 
  5. % Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
  6. % or distributor accepts any responsibility for the consequences of using it,
  7. % or for whether it serves any particular purpose or works at all, unless he
  8. % or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
  9. % License (the "License") for full details.
  10. % 
  11. % Every copy of Aladdin Ghostscript must include a copy of the License,
  12. % normally in a plain ASCII text file named PUBLIC.  The License grants you
  13. % the right to copy, modify and redistribute Aladdin Ghostscript, but only
  14. % under certain conditions described in the License.  Among other things, the
  15. % License requires that the copyright notice and this notice be preserved on
  16. % all copies.
  17.  
  18. % Initialization file for Level 2 functions.
  19. % When this is run, systemdict is still writable,
  20. % but (almost) everything defined here goes into level2dict.
  21.  
  22. level2dict begin
  23.  
  24. % ------ System and user parameters ------ %
  25.  
  26. % User parameters are managed entirely in C code.
  27. /currentuserparams {        % - currentuserparams <dict>
  28.   mark .currentuserparams .dicttomark
  29.  } odef
  30. systemdict begin
  31. /getuserparam {            % <name> getuserparam <value>
  32.   .getuserparam
  33. } odef
  34. end
  35.  
  36. % Some system parameters are managed entirely at the PostScript level.
  37. % We take care of that here.
  38. systemdict begin
  39. currentdict /systemparams known not {
  40.   /systemparams 10 dict readonly def
  41. } if
  42. /getsystemparam {        % <name> getsystemparam <value>
  43.   //systemparams 1 index .knownget { exch pop } { .getsystemparam } ifelse
  44. } odef
  45. end
  46. /currentsystemparams {        % - currentsystemparams <dict>
  47.   mark .currentsystemparams //systemparams { } forall .dicttomark
  48. } odef
  49. /.setsystemparams /setsystemparams load def
  50. /setsystemparams {        % <dict> setsystemparams -
  51.     % Check that we will be able to set the PostScript-level
  52.     % system parameters.
  53.    dup
  54.     { //systemparams 3 -1 roll .knownget
  55.        { type 1 index type ne
  56.       { pop /setsystemparams load /typecheck signalerror }
  57.      if
  58.      dup type /stringtype eq
  59.       { dup dup gcheck exch rcheck or not
  60.          { /setsystemparams load /invalidaccess signalerror }
  61.         if
  62.       }
  63.      if pop
  64.        }
  65.        { pop
  66.        }
  67.       ifelse
  68.     }
  69.    forall
  70.     % Set the C-level system params.  If this succeeds, we know that
  71.     % the password check succeeded.
  72.    dup .setsystemparams
  73.     % Now set the PostScript-level params.  We must copy local strings
  74.     % into global VM.
  75.    dup
  76.     { //systemparams 2 index known
  77.        {        % Stack: key newvalue
  78.      dup gcheck not
  79.       {        % The only composite objects that can have passed
  80.             % the type check are strings.
  81.         .currentglobal true .setglobal
  82.         1 index length string exch .setglobal
  83.         copy readonly
  84.       }
  85.      if //systemparams 3 1 roll .forceput
  86.        }
  87.        { pop pop
  88.        }
  89.       ifelse
  90.     }
  91.    forall pop
  92. } odef
  93.  
  94. % ------ Miscellaneous ------ %
  95.  
  96. (<<) cvn            % - << -mark-
  97.   /mark load def
  98. (>>) cvn            % -mark- <key1> <value1> ... >> <dict>
  99.   /.dicttomark load def
  100. /languagelevel 2 def
  101. % When running in Level 2 mode, this interpreter is supposed to be
  102. % compatible with PostScript version 2010 (I think).
  103. /version (2010) def
  104.  
  105. % If binary tokens are supported by this interpreter,
  106. % set an appropriate default binary object format.
  107. /setobjectformat where
  108.  { pop
  109.    /RealFormat getsystemparam (IEEE) eq { 1 } { 3 } ifelse
  110.    /ByteOrder getsystemparam { 1 add } if
  111.    setobjectformat
  112.  } if
  113.  
  114. % ------ Virtual memory ------ %
  115.  
  116. /currentglobal            % - currentglobal <bool>
  117.   /currentshared load def
  118. /gcheck                % <obj> gcheck <bool>
  119.   /scheck load def
  120. /setglobal            % <bool> setglobal -
  121.   /setshared load def
  122. % We can make the global dictionaries very small, because they auto-expand.
  123. /globaldict currentdict /shareddict .knownget not { 4 dict } if def
  124. /GlobalFontDirectory SharedFontDirectory def
  125.  
  126. % ------ IODevices ------ %
  127.  
  128. /.getdevparams where {
  129.   pop /currentdevparams {    % <iodevice> currentdevparams <dict>
  130.     .getdevparams .dicttomark
  131.   } odef
  132. } if
  133. /.putdevparams where {
  134.   pop /setdevparams {        % <iodevice> <dict> setdevparams -
  135.     mark 1 index { } forall counttomark 2 add index
  136.     .putdevparams pop pop
  137.   } odef
  138. } if
  139.  
  140. % ------ Job control ------ %
  141.  
  142. serverdict begin
  143.  
  144. % We could protect the job information better, but we aren't attempting
  145. % (currently) to protect ourselves against maliciousness.
  146.  
  147. /.jobsave null def        % top-level save object
  148. /.jobsavelevel 0 def        % save depth of job (0 if .jobsave is null,
  149.                 % 1 otherwise)
  150. /.adminjob true def        % status of current unencapsulated job
  151.  
  152. /exitserver {            % <password> exitserver -
  153.   true exch startjob not { /exitserver /invalidaccess signalerror } if
  154. } bind def
  155.  
  156. end        % serverdict
  157.  
  158. % Because there may be objects on the e-stack created since the job save,
  159. % we have to clear the e-stack before doing the end-of-job restore.
  160. % We do this by executing a 2 .stop, which is caught by the 2 .stopped
  161. % in .runexec; we leave on the o-stack a procedure to execute aftewards.
  162. %
  163. %**************** The definition of startjob is not complete yet, since
  164. % it doesn't reset stdin/stdout or other aspects of the interpreter.
  165. /.finishstartjob {        % <exit_bool> <password_level>
  166.                 %   .finishstartjob -true-
  167.     serverdict /.jobsave get dup null eq { pop } { restore } ifelse
  168.     exch {
  169.             % Unencapsulated job
  170.       serverdict /.jobsave null put
  171.       serverdict /.jobsavelevel 0 put
  172.       serverdict /.adminjob 3 -1 roll 1 gt put
  173.     } {
  174.             % Encapsulated job
  175.       pop
  176.       serverdict /.jobsave save put
  177.       serverdict /.jobsavelevel 1 put
  178.       userdict /quit /stop load put
  179.     } ifelse true
  180. } bind def
  181. /startjob {            % <exit_bool> <password> startjob <ok_bool>
  182.   vmstatus pop pop serverdict /.jobsavelevel get eq
  183.   1 index .checkpassword 0 gt and {
  184.     .checkpassword count 2 roll count 2 sub { pop } repeat
  185.     cleardictstack
  186.         % Reset the e-stack back to the 2 .stopped in .runexec.
  187.     { .finishstartjob } 2 .stop
  188.   } {        % Password check failed
  189.     pop pop false
  190.   } ifelse
  191. } odef
  192.  
  193. systemdict begin
  194. /quit {                % - quit -
  195.   //systemdict begin serverdict /.jobsave get null eq
  196.    { end //quit }
  197.    { /quit load /invalidaccess /signalerror load end exec }
  198.   ifelse
  199. } bind odef
  200. end
  201.  
  202. % ------ Compatibility ------ %
  203.  
  204. % In Level 2 mode, the following replace the definitions that gs_statd.ps
  205. % installs in statusdict and serverdict.
  206. % Note that statusdict must be allocated in local VM.
  207. % We don't bother with many of these yet.
  208.  
  209. /.dict1 { exch mark 3 1 roll .dicttomark } bind def
  210.  
  211. currentglobal false setglobal 25 dict exch setglobal begin
  212. currentsystemparams
  213.  
  214. /buildtime 1 index /BuildTime get def
  215. /byteorder 1 index /ByteOrder get def
  216. /checkpassword { .checkpassword 0 gt } bind def
  217. /defaulttimeouts
  218.  { currentsystemparams dup
  219.    /JobTimeout .knownget not { 0 } if
  220.    exch /WaitTimeout .knownget not { 0 } if
  221.    currentpagedevice /ManualFeedTimeout .knownget not { 0 } if
  222.  } bind def
  223. dup /DoStartPage known
  224.  { /dostartpage { /DoStartPage getsystemparam } bind def
  225.    /setdostartpage { /DoStartPage .dict1 setsystemparams } bind def
  226.  } if
  227. dup /StartupMode known
  228.  { /dosysstart { /StartupMode getsystemparam 0 ne } bind def
  229.    /setdosysstart { { 1 } { 0 } ifelse /StartupMode .dict1 setsystemparams } bind def
  230.  } if
  231. %****** Setting jobname is supposed to set userparams.JobName, too.
  232. /jobname { /JobName getuserparam } bind def
  233. /jobtimeout { /JobTimeout getuserparam } bind def
  234. %manualfeed
  235. %manualfeedtimeout
  236. /margins
  237.  { currentpagedevice /Margins .knownget { exch } { [0 0] } ifelse
  238.  } bind def
  239. %pagecount
  240. %pagestackorder
  241. /printername
  242.  { currentsystemparams /PrinterName .knownget not { () } if exch copy
  243.  } bind def
  244. %/ramsize { /RamSize getsystemparam } bind def
  245. /realformat 1 index /RealFormat get def
  246.  
  247. /.setpagedevice where
  248.  { pop
  249.    /setdefaulttimeouts
  250.     { exch mark /ManualFeedTimeout 3 -1 roll
  251.       /Policies mark /ManualFeedTimeout 1 .dicttomark
  252.       .dicttomark setpagedevice
  253.       /WaitTimeout exch mark /JobTimeout 5 2 roll .dicttomark setsystemparams
  254.     } bind def
  255.    /setmargins
  256.     { exch 2 array astore /Margins .dict1 setpagedevice
  257.     } bind def
  258.  }
  259. if
  260. %setpagestackorder
  261. dup /PrinterName known
  262.  { /setprintername { /PrinterName .dict1 setsystemparams } bind def
  263.  } if
  264. currentuserparams /WaitTimeout known
  265.  { /waittimeout { /WaitTimeout getuserparam } bind def
  266.  } if
  267.  
  268. /.setpagedevice where
  269.  { pop 
  270.    /pagemargin
  271.     { currentpagedevice /PageOffset .knownget { 0 get } { 0 } ifelse
  272.     } bind def
  273.    /pageparams
  274.     { currentpagedevice
  275.       dup /Orientation .knownget { 1 and ORIENT1 { 1 xor } if } { 0 } ifelse exch
  276.       dup /PageSize get aload pop 3 index 0 ne { exch } if 3 2 roll
  277.       /PageOffset .knownget { 0 get } { 0 } ifelse 4 -1 roll
  278.     } bind def
  279.    /.setpagesize { 2 array astore /PageSize .dict1 setpagedevice } bind def
  280.    /setduplexmode { /Duplex .dict1 setpagedevice } bind def
  281.    /setpagemargin { 0 2 array astore /PageOffset .dict1 setpagedevice } bind def
  282.    /setpageparams
  283.     { mark /PageSize 6 -2 roll
  284.       4 index 1 and ORIENT1 { 1 } { 0 } ifelse ne { exch } if 2 array astore
  285.       /Orientation 5 -1 roll ORIENT1 { 1 xor } if
  286.       /PageOffset counttomark 2 add -1 roll 0 2 array astore
  287.       .dicttomark setpagedevice
  288.     } bind def
  289.    /setresolution
  290.     { dup 2 array astore /HWResolution .dict1 setpagedevice
  291.     } bind def
  292.  }
  293. if
  294.  
  295. pop        % currentsystemparams
  296.  
  297. % Flag the current dictionary so it will be swapped when we
  298. % change language levels.  (See zmisc2.c for more information.)
  299. /statusdict currentdict def
  300.  
  301. currentdict end
  302. /statusdict exch def
  303.  
  304. % ------ Color spaces ------ %
  305.  
  306. % Define the setcolorspace procedures:
  307. %    <colorspace> proc <colorspace'|null>
  308. /colorspacedict mark
  309.   /DeviceGray { pop 0 setgray null } bind
  310.   /DeviceRGB { pop 0 0 0 setrgbcolor null } bind
  311.   /setcmykcolor where
  312.    { pop /DeviceCMYK { pop 0 0 0 1 setcmykcolor null } bind
  313.    } if
  314.   /.setcieaspace where
  315.    { pop /CIEBasedA { NOCIE { pop 0 setgray null } { dup 1 get .setcieaspace } ifelse } bind
  316.    } if
  317.   /.setcieabcspace where
  318.    { pop /CIEBasedABC { NOCIE { pop 0 0 0 setrgbcolor null } { dup 1 get .setcieabcspace } ifelse } bind
  319.    } if
  320.   /.setciedefspace where
  321.    { pop /CIEBasedDEF { NOCIE { pop 0 0 0 setrgbcolor null } { dup 1 get .setciedefspace } ifelse } bind
  322.    } if
  323.   /.setciedefgspace where
  324.    { pop /CIEBasedDEFG { NOCIE { pop 0 0 0 1 setcmykcolor null } { dup 1 get .setciedefgspace } ifelse } bind
  325.    } if
  326.   /.setseparationspace where
  327.    { pop /Separation { dup 2 get setcolorspace dup .setseparationspace } bind
  328.    } if
  329.   /.setindexedspace where
  330.    { pop /Indexed { dup 1 get setcolorspace dup .setindexedspace } bind
  331.    } if
  332.   /.nullpatternspace [/Pattern] readonly def
  333.   /.setpatternspace where
  334.    { pop /Pattern
  335.       { dup type /nametype eq { pop //.nullpatternspace } if
  336.     dup length 1 gt { dup 1 get setcolorspace } if
  337.         dup .setpatternspace
  338.       } bind
  339.    } if
  340.   currentdict /.nullpatternspace .undef
  341. .dicttomark def
  342.  
  343. /.devcs [/DeviceGray /DeviceRGB /DeviceCMYK] readonly def
  344. /currentcolorspace {        % - currentcolorspace <array>
  345.   .currentcolorspace dup type /integertype eq {
  346.     //.devcs exch 1 getinterval
  347.   } if
  348. } odef
  349. currentdict /.devcs .undef
  350.  
  351. /setcolorspace {        % <name|array> setcolorspace -
  352.   dup dup dup type /nametype ne { 0 get } if
  353.   //colorspacedict exch get exec
  354.   dup null eq { pop } { .setcolorspace } ifelse pop
  355. } odef
  356.  
  357. % ------ CIE color rendering ------ %
  358.  
  359. /setcolorrendering where { pop } { (%END CRD) .skipeof } ifelse
  360.  
  361. % Initialize the CIE rendering dictionary if necessary.
  362. % The most common CIE files seem to assume the "calibrated RGB color space"
  363. % described on p. 189 of the PostScript Language Reference Manual,
  364. % 2nd Edition; we simply invert this transformation back to RGB.
  365. mark
  366.    /ColorRenderingType 1
  367. % We must make RangePQR and RangeLMN large enough so that values computed by
  368. % the assumed encoding MatrixLMN don't get clamped.
  369.    /RangePQR [0 0.9505 0 1 0 1.0890]
  370.    /TransformPQR [ { 4 { exch pop } repeat } dup dup ]
  371.    /RangeLMN [0 0.9505 0 1 0 1.0890]
  372.    /MatrixABC
  373.     [ 3.24063 -0.96893  0.05571
  374.      -1.53721  1.87576 -0.20402
  375.      -0.49863  0.04152  1.05700
  376.     ]
  377.    /EncodeABC [{0 max 0.45 exp} bind dup dup]
  378.    /WhitePoint [0.9505 1 1.0890]
  379.     % Some Genoa tests seem to require the presence of BlackPoint.
  380.    /BlackPoint [0 0 0]
  381. .dicttomark setcolorrendering
  382.  
  383. % Define findcolorrendering and a default ColorRendering ProcSet.
  384.  
  385. /findcolorrendering {        % <intentname> findcolorrendering
  386.                 %   <crdname> <found>
  387.   /ColorRendering /ProcSet findresource
  388.   1 index .namestring (.) concatstrings
  389.   1 index /GetPageDeviceName get exec .namestring (.) concatstrings
  390.   2 index /GetHalftoneName get exec .namestring
  391.   concatstrings concatstrings
  392.   dup /ColorRendering resourcestatus {
  393.     pop pop exch pop exch pop true
  394.   } {
  395.     pop /GetSubstituteCRD get exec false
  396.   } ifelse
  397. } odef
  398.  
  399. 5 dict dup begin
  400.  
  401. /GetPageDeviceName {        % - GetPageDeviceName <name>
  402.   currentpagedevice dup /PageDeviceName .knownget {
  403.     exch pop
  404.   } {
  405.     pop /none
  406.   } ifelse
  407. } bind def
  408.  
  409. /GetHalftoneName {        % - GetHalftoneName <name>
  410.   currenthalftone /HalftoneName .knownget not { /none } if
  411. } bind def
  412.  
  413. /GetSubstituteCRD {        % <intentname> GetSubstituteCRD <crdname>
  414.   pop /DefaultColorRendering
  415. } bind def
  416.  
  417. end
  418. % The resource machinery hasn't been activated, so just save the ProcSet
  419. % and let .fixresources finish the installation process.
  420. /ColorRendering exch def
  421.  
  422. %END CRD
  423.  
  424. % ------ Painting ------ %
  425.  
  426. % A straightforward definition of execform that doesn't actually
  427. % do any caching.
  428. /.execform1
  429.  {    % This is a separate operator so that the stacks will be restored
  430.     % properly if an error occurs.
  431.    dup /Implementation known not
  432.     { dup /FormType get 1 ne { /rangecheck signalerror } if
  433.       dup /Implementation null put readonly
  434.     } if
  435.    dup /Matrix get concat
  436.    dup /BBox get aload pop
  437.    exch 3 index sub exch 2 index sub rectclip
  438.    dup /PaintProc get exec
  439.  } odef
  440. /execform            % <form> execform -
  441.  { gsave { .execform1 } stopped grestore { stop } if
  442.  } odef
  443.  
  444. /makepattern {            % <proto_dict> <matrix> makepattern <pattern>
  445.   1 index dup length 1 add currentglobal
  446.    { false setglobal dict .copydict 1 index .buildpattern true setglobal }
  447.    { dict .copydict 1 index .buildpattern }
  448.   ifelse
  449.   1 index /Implementation 3 -1 roll put
  450.   readonly exch pop exch pop
  451. } odef
  452.  
  453. /setpattern {            % [<comp1> ...] <pattern> setpattern -
  454.   currentcolorspace 0 get /Pattern ne {
  455.     [ /Pattern currentcolorspace ] setcolorspace
  456.   } if setcolor
  457. } odef
  458.  
  459. end                % level2dict
  460.